home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
qbnws104.zip
/
FOSSIL.ZIP
/
FOSSIL2.BAS
< prev
Wrap
BASIC Source File
|
1990-07-29
|
20KB
|
739 lines
DECLARE SUB Parser (Parse$, Params%, Arg$())
DECLARE SUB Terminal (ComPort%, AnsiHand%, Baud$, HandShake%, Echo%, LineFeeds%, Reg AS ANY)
DECLARE SUB AnsiPrint (AnsiHand%, Send$)
DECLARE SUB FossilDeInit (ComPort%, Reg AS ANY)
DECLARE SUB FossilInit (ComPort%, Reg AS ANY)
DECLARE SUB Recieve (ComPort%, Send%, Reg AS ANY)
DECLARE SUB SetDtr (ComPort%, DtrStatus$, Reg AS ANY)
DECLARE SUB SetHandShake (ComPort%, HandShake%, Reg AS ANY)
DECLARE SUB SetPortParams (ComPort%, Baud$, Bits%, Stops%, Parity$, Reg AS ANY)
DECLARE SUB Status (ComPort%, Info%, Reg AS ANY)
DECLARE SUB Transmit (ComPort%, Send%, Reg AS ANY)
DECLARE SUB BaudSelect (ComPort%, AnsiHand%, Baud$, Bits%, Stops%, Parity$, Reg AS ANY)
' *****************
' ** Fossil.Bas **
' *****************
'
' $INCLUDE: 'QB.BI' ' Include Data Types for INTERRUPT calls
Version$ = "Fossil Version 2.00a" ' Program version stamp
VersionDate$ = "July 29th, 1990"
DIM SHARED Reg AS RegType ' Used for INTERRUPT calls
DIM Arg$(20) ' Used for command line parser
CrLf$ = CHR$(&HD) + CHR$(&HA) ' A Carriage return + linefeed string
Baud$ = "9600"
HandShake% = 2
ComPort% = 0
Echo% = 0
LOCATE , , 1 ' Turn curser on
CALL AnsiPrint(AnsiHand%, CHR$(27) + "[2J") ' Clear the screen
CALL AnsiPrint(AnsiHand%, CrLf$ + Version$ + CrLf$)
CALL AnsiPrint(AnsiHand%, "By Chris Wagner " + VersionDate$ + CrLf$ + CrLf$)
Parse$ = UCASE$(COMMAND$) ' Get command line paramaters
CALL Parser(Parse$, Params%, Arg$())
FOR Counter1% = 1 TO Params%
SELECT CASE LEFT$(Arg$(Counter1%), 3)
CASE "-BD" ' Set baud rate
Baud$ = RIGHT$(Arg$(Counter1%), LEN(Arg$(Counter1%)) - 3)
CALL AnsiPrint(AnsiHand%, "Setting Baud rate set to " + Baud$ + CrLf$)
CASE "-CP" ' Set COM port
ComPort% = VAL(RIGHT$(Arg$(Counter1%), LEN(Arg$(Counter1%)) - 3)) - 1
SELECT CASE ComPort%
CASE 0 TO 3
CALL AnsiPrint(AnsiHand%, "Using Comminications port COM" + LTRIM$(STR$(ComPort% + 1)) + CrLf$)
CASE ELSE
ComPort% = 0
CALL AnsiPrint(AnsiHand%, "Invalid Communications port parameter: " + Arg$(Counter1%) + CrLf$)
CALL AnsiPrint(AnsiHand%, "Using Comminications port COM1" + CrLf$)
END SELECT
CASE "-HS" ' Set handshake type
HandShake$ = UCASE$(RIGHT$(Arg$(Counter1%), LEN(Arg$(Counter1%)) - 3))
HandShake% = VAL("&H" + HandShake$)
IF HandShake% > &HF THEN
CALL AnsiPrint(AnsiHand%, "Bad HandShake Enable parameter: " + LTRIM$(STR$(HandShake%)) + CrLf$)
END IF
CASE "-LR" ' Add linefeeds to received carriage returns
LineFeeds% = LineFeeds% OR 1
CASE "-LT" ' Add linefeeds to transmitted carriage returns
LineFeeds% = LineFeeds% OR 2
CASE "-EC" ' Set local echo on or off
Echo$ = UCASE$(RIGHT$(Arg$(Counter1%), LEN(Arg$(Counter1%)) - 3))
Echo% = VAL(LEFT$(Echo$, 1))
CASE ELSE
CALL AnsiPrint(AnsiHand%, "Invalid Parameter: " + CHR$(34) + Arg$(Counter1%) + CHR$(34) + CrLf$)
END SELECT
NEXT Counter1%
CALL Terminal(ComPort%, AnsiHand%, Baud$, HandShake%, Echo%, LineFeeds%, Reg) ' The terminal itself
CALL AnsiPrint(AnsiHand%, CHR$(27) + "[2J") ' Clear the screen
AnsiHand% = -1
CALL AnsiPrint(AnsiHand%, "")
CALL FossilDeInit(ComPort%, Reg)
END
SUB AnsiPrint (AnsiHand%, Send$)
SELECT CASE AnsiHand%
CASE 0
AnsiHand% = FREEFILE
OPEN "CONS:" FOR OUTPUT AS #AnsiHand%
CASE -1
CLOSE #AnsiHand%
AnsiHand% = 0
EXIT SUB
CASE ELSE
END SELECT
PRINT #AnsiHand%, Send$;
END SUB
SUB BaudSelect (ComPort%, AnsiHand%, Baud$, Bits%, Stops%, Parity$, Reg AS RegType)
CrLf$ = CHR$(&HD) + CHR$(&HA)
CALL AnsiPrint(AnsiHand%, CrLf$)
CALL AnsiPrint(AnsiHand%, "Current baud rate: " + Baud$ + CrLf$)
CALL AnsiPrint(AnsiHand%, CrLf$)
CALL AnsiPrint(AnsiHand%, "Select a baud rate:" + CrLf$)
CALL AnsiPrint(AnsiHand%, " A. 300" + CrLf$)
CALL AnsiPrint(AnsiHand%, " B. 600" + CrLf$)
CALL AnsiPrint(AnsiHand%, " C. 1200" + CrLf$)
CALL AnsiPrint(AnsiHand%, " D. 2400" + CrLf$)
CALL AnsiPrint(AnsiHand%, " E. 4800" + CrLf$)
CALL AnsiPrint(AnsiHand%, " F. 9600" + CrLf$)
CALL AnsiPrint(AnsiHand%, " G. 19200" + CrLf$)
CALL AnsiPrint(AnsiHand%, " H. 38400" + CrLf$)
CALL AnsiPrint(AnsiHand%, " Q. No Change" + CrLf$)
CALL AnsiPrint(AnsiHand%, CrLf$)
WHILE INKEY$ <> "": WEND ' Clear the keyboard buffer
DO
SELECT CASE UCASE$(INKEY$)
CASE ""
CASE "A"
Baud$ = "300"
EXIT DO
CASE "B"
Baud$ = "600"
EXIT DO
CASE "C"
Baud$ = "1200"
EXIT DO
CASE "D"
Baud$ = "2400"
EXIT DO
CASE "E"
Baud$ = "4800"
EXIT DO
CASE "F"
Baud$ = "9600"
EXIT DO
CASE "G"
Baud$ = "19200"
EXIT DO
CASE "H"
Baud$ = "38400"
EXIT DO
CASE "Q"
CALL AnsiPrint(AnsiHand%, "Baud not changed" + CrLf$)
CALL AnsiPrint(AnsiHand%, CrLf$)
EXIT SUB
CASE ELSE
END SELECT
LOOP
CALL SetPortParams(ComPort%, Baud$, Bits%, Stops%, Parity$, Reg)
CALL AnsiPrint(AnsiHand%, "Baud changed to: " + Baud$ + CrLf$)
END SUB
SUB FossilDeInit (ComPort%, Reg AS RegType)
' Release the FOSSIL device driver (Call when finished)
'
' ah = &H05 Fossil Function Number - DeInitialize FOSSIL driver
' al = &H00 Place Holder
' dx = Communications port number (0-3)
Reg.ax = &H500
Reg.dx = ComPort%
CALL Interrupt(&H14, Reg, Reg)
END SUB
SUB FossilInit (ComPort%, Reg AS RegType)
' Initialize the FOSSIL device driver
'
' dx = Communications port number (0-3)
' ah = &H04 Fossil Function Number - Initialize FOSSIL driver
' (Raises DTR in the porcess)
Reg.dx = ComPort%
Reg.ax = &H400
CALL Interrupt(&H14, Reg, Reg)
IF Reg.ax <> &H1954 THEN
CLS
PRINT
PRINT "ERROR: Fossil Driver not responding - READ MANUAL!"
PRINT "You may need to add DEVICE={path}\X00.SYS for proper operation"
PRINT " (Note: {path} means the drive:\path where the file is located"
PRINT
SLEEP (5)
END
END IF
END SUB
' DECLARE SUB Parser (Parse$, Params%, Arg$())
'
' DIM Arg$(50)
' CLS
'
' Parse$ = " 1a 2bb 3ccc 4dddd 5eeeee 6ffffff "
'
' CALL Parser(Parse$, Params%, Arg$())
'
' FOR Counter1% = 1 TO Params%
' PRINT Counter1%, CHR$(34) + Arg$(Counter1%) + CHR$(34)
' NEXT Counter1%
'
' Argument splitter by Chris Wagner
' call with:
'
' Parse$ = input to be divided
'
' Returns:
' Params% Number of parameters
' Arg$() Array of arguments, starting at 1
'
'
SUB Parser (Parse$, Params%, Arg$())
Params% = 0
Temp$ = RTRIM$(Parse$)
DO
Temp$ = LTRIM$(Temp$)
IF LEN(Temp$) = 0 THEN EXIT DO
Temp% = INSTR(Temp$, SPACE$(1))
IF Temp% = 0 THEN
Params% = Params% + 1
Arg$(Params%) = Temp$
EXIT DO
END IF
Arg$(Params% + 1) = RTRIM$(LEFT$(Temp$, Temp%))
Temp$ = RIGHT$(Temp$, LEN(Temp$) - Temp%)
IF LEN(Arg$(Params% + 1)) > 0 THEN Params% = Params% + 1
LOOP
END SUB
SUB Recieve (ComPort%, Send%, Reg AS RegType)
CALL Status(ComPort%, Info%, Reg) ' Test for space in OUTPUT buffer
IF (Info% AND &H4) = 0 THEN
IF (Info% AND &H2) = &H2 THEN
' ah = &H02 Fossil Function Number - Recieve Character
' al = &H00 Place Holder
' dx = Communications port (0-3)
Reg.ax = &H200
Reg.dx = ComPort%
CALL Interrupt(&H14, Reg, Reg)
Send% = Reg.ax
ELSE
Send% = -1 ' No Characters in input buffer
END IF
ELSE ' Input buffer over-run
Send% = -2
' ah = &H0A Fossil Function Number - Purge INPUT Buffer
' al = &H00 Place Holder
' dx = Communications port (0-3)
Reg.ax = &HA00
Reg.dx = ComPort%
CALL Interrupt(&H14, Reg, Reg)
CLS
PRINT
PRINT " *** Input buffer over-run."
PRINT " Buffer purged."
PRINT
SLEEP (5)
END IF
END SUB
SUB SetDtr (ComPort%, DtrStatus$, Reg AS RegType)
' ah =